home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
User's Choice Windows CD
/
User's Choice Windows CD (CMS Software)(1993).iso
/
windows3
/
metavi.zip
/
DISPMETA.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-09
|
6KB
|
214 lines
program DisplayMetafiles;
{$R VIEWMETA.RES}
uses WinTypes, WinProcs, WObjects,
Strings, StdDlgs, ViewMeta;
const
id_Viewer = 201;
cm_Open = 101;
cm_About = 102;
cm_PreserveAspect = 103;
cm_DialogExample = 104;
type
PMyChildWindow = ^MyChildWindow;
MyChildWindow = object(TWindow)
MetaWnd : PMetafileViewer;
constructor Init(AParent: PWindowsObject; ATitle: PChar);
destructor Done; virtual;
function GetClassName: PChar; virtual;
procedure GetWindowClass(var AWndClass: TWndClass); virtual;
procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
procedure WMMDIActivate(var Msg: TMessage); virtual wm_First + wm_MDIActivate;
procedure CMPreserveAspect(var Msg: TMessage); virtual cm_First + cm_PreserveAspect;
procedure SetPreserveAspectCheckMark; virtual;
procedure IDViewer(var Msg: TMessage); virtual id_First + id_Viewer;
end;
PMyMDIWindow = ^MyMDIWindow;
MyMDIWindow = object(TMDIWindow)
AName:PChar;
constructor Init(ATitle: PChar; AMenu: HMenu);
destructor Done; virtual;
procedure GetWindowClass(var AWndClass: TWndClass); virtual;
procedure SetupWindow; virtual;
function InitChild: PWindowsObject; virtual;
procedure CMOpen(var Msg: TMessage); virtual cm_First + cm_Open;
procedure CMAbout(var Msg: TMessage); virtual cm_First + cm_About;
procedure CMDialogExample(var Msg:TMessage); virtual cm_First + cm_DialogExample;
end;
PMyApplication = ^MyApplication;
MyApplication = object(TApplication)
constructor Init(AName: PChar);
procedure InitMainWindow; virtual;
destructor Done; virtual;
end;
{**************************************************************}
constructor MyChildWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
TWindow.Init(AParent, ATitle);
Attr.Style:= Attr.Style + ws_Child;
MetaWnd:= New(PMetafileViewer, Init(@Self, id_Viewer,
ATitle, cw_UseDefault, cw_UseDefault,
cw_UseDefault, cw_UseDefault, True, False));
end;
destructor MyChildWindow.Done;
begin
TWindow.Done;
end;
function MyChildWindow.GetClassName: PChar;
begin
GetClassName:= 'MyChildWindow';
end;
procedure MyChildWindow.GetWindowClass(var AWndClass: TWndClass);
begin
TWindow.GetWindowClass(AWndClass);
AWndClass.hIcon:= LoadIcon(HInstance, 'METAV_ICON');
end;
procedure MyChildWindow.WMSize(var Msg: TMessage);
begin
TWindow.WMSize(Msg);
MoveWindow(MetaWnd^.HWindow, 0, 0, Msg.lParamLo, Msg.lParamHi, True);
end;
procedure MyChildWindow.IDViewer(var Msg: TMessage);
begin
if (Msg.lParamHi = mfn_Clicked) then
begin
{Metafile Client area was clicked on}
end
else if (Msg.lParamHi = mfn_DblClicked) then
begin
{Metafile Client area was double clicked on}
end
else if (Msg.lParamHi = mfn_Aldus) then
begin
{Metafile is an Aldus metafile}
end
else if (Msg.lParamHi = mfn_MSoft) then
begin
{Metafile is an Microsoft metafile}
end;
end;
procedure MyChildWindow.WMMDIActivate(var Msg: TMessage);
begin
if (Msg.wParam <> 0) then {Window is being activated}
begin
SetPreserveAspectCheckMark;
end;
end;
procedure MyChildWindow.CMPreserveAspect(var Msg: TMessage);
begin
MetaWnd^.ToggleAspect;
SetPreserveAspectCheckMark;
end;
procedure MyChildWindow.SetPreserveAspectCheckMark;
var
MenuHandle : HMenu;
CheckStatus : word;
begin
if MetaWnd^.AspectRatioPreserved then
CheckStatus:= mf_Checked
else
CheckStatus:= mf_UnChecked;
MenuHandle:= GetMenu(Application^.MainWindow^.HWindow);
CheckMenuItem(MenuHandle, cm_PreserveAspect ,CheckStatus);
end;
{**************************************************************}
constructor MyMDIWindow.Init(ATitle: PChar; AMenu: HMenu);
begin
TMDIWindow.Init(ATitle, AMenu);
ChildMenuPos:= 2;
end;
destructor MyMDIWindow.Done;
begin
TMDIWindow.Done;
end;
procedure MyMDIWindow.GetWindowClass(var AWndClass: TWndClass);
begin
TWindow.GetWindowClass(AWndClass);
AWndClass.hIcon:= LoadIcon(HInstance, 'APGM_ICON');
end;
procedure MyMDIWindow.SetupWindow;
begin
TMDIWindow.SetupWindow;
end;
function MyMDIWindow.InitChild: PWindowsObject;
begin
InitChild:= New(PMyChildWindow, Init(@Self, AName));
end;
procedure MyMDIWindow.CMOpen(var Msg: TMessage);
var
AFile: array[0..100] of char;
begin
StrCopy(AFile, '*.WMF');
if Application^.ExecDialog(New(PFileDialog, Init(@Self,
PChar(sd_FileOpen), AFile))) = id_OK then
begin
AName:= AFile;
CreateChild;
end;
DefWndProc(Msg);
end;
procedure MyMDIWindow.CMAbout(var Msg: TMessage);
begin
Application^.ExecDialog(
New(PDialog, Init(@Self, 'ABOUT')));
end;
procedure MyMDIWindow.CMDialogExample(var Msg:TMessage);
begin
Application^.ExecDialog(
New(PDialog, Init(@Self, 'META_DLG')));
end;
{**************************************************************}
constructor MyApplication.Init(AName: PChar);
begin
TApplication.Init(AName);
end;
procedure MyApplication.InitMainWindow;
begin
MainWindow:= New(PMyMDIWindow, Init('Metafile Viewer', LoadMenu(HInstance, 'DEFAULT_MENU')));
end;
destructor MyApplication.Done;
begin
TApplication.Done;
end;
{**************************************************************}
var
MyApp : MyApplication;
begin
MyApp.Init('Metafile Viewer');
MyApp.Run;
MyApp.Done;
end.